#!/usr/bin/perl
#
# $Id: cmetricd 6076 2007-02-01 18:33:09Z focht $
#
# Copytight (c) 2006 Erich Focht

use strict;
use Data::Dumper;
use Getopt::Long;
use Sys::Syslog qw( :DEFAULT setlogsock);
use File::Basename;
use Socket;
use Event qw(loop unloop);
require Event::timer;


my $progname = basename($0);
my $cfgdir = "/etc/cmetric.d";
my $gmond_conf="/etc/gmond.conf";
my $gmetric="/usr/bin/gmetric";
my $callback_timeout = 20;
my $gmond_channel = undef;
my $gmond_if = undef;
my $gmond_port = undef;

my ($gmond_port, $verbose, $debug);
GetOptions( 'verbose|v!' => \$verbose,
	    'debug|d'    => \$debug,
	    );


sub logit {
    my ($priority, $msg) = @_;
    return 0 unless ($priority =~ /info|err|debug/);

    setlogsock('unix');
    openlog($progname, 'pid', 'user');
    syslog($priority, $msg);
    closelog();
    return 1;
}

my $pid;

my %cfg;
&parse_cfg_dir($cfgdir);
exit 1 if (&validate_cfg(%cfg));

my %callbacks = &callbacks_cfg(%cfg);

if ($debug) {
    #
    # don't fork background process in debug mode
    #
    &setup_callbacks(%callbacks);
    loop();
} else {
    #
    # daemon mode: go to background and report only over syslog
    #
  FORK:
    {
	if ($pid = fork()) {
	    # parent returns
	    close STDOUT;
	    close STDERR;
	    close STDIN;
	    exit 0;
	} elsif (defined $pid) {
	    # ### child ###
	    close STDOUT;
	    close STDERR;
	    close STDIN;
	    &setup_callbacks(%callbacks);
	    # main loop
	    loop();
	    exit 1;
	} elsif ($! =~ /No more process/) {
	    sleep 5;
	    redo FORK;
	} else {
	    die "Can't fork: $!\n";
	}
    }
}
exit 0;

#=============================================================
sub logit {
    my ($priority, $msg) = @_;
    return 0 unless ($priority =~ /info|err|debug/);
    if ($debug) {
	print STDERR $msg."\n";
    } else {
	setlogsock('unix');
	openlog($progname, 'pid', 'user');
	syslog($priority, $msg);
	closelog();
	return 1;
    }
}

sub setup_callbacks {
    for my $cmd (keys(%callbacks)) {
	my $w = Event->timer(interval => $callbacks{$cmd}{interval},
			     parked => 1,
			     data => $cmd,
			     cb   => \&worker,
			     max_cb_tm => $callback_timeout,
			     );
	$callbacks{$cmd}{watcher} = $w;
	$w->start();
    }
}

sub worker {
    my ($event) = @_;
    my $cmd = $event->w->data;
    #print "Event: $cmd at ".scalar localtime(Event::time())."\n";
    #
    # Implement metrics output collection and running through
    # all associated parsing blocks.
    #

    my $interval = $callbacks{$cmd}{interval};
    #
    # Do we need to load modules?
    #
    &load_modules($callbacks{$cmd}{blocks});

    #
    # collect output
    #
    local *CMD;
    if (!open CMD, "$cmd |") {
	logit "err", "Could not run: $cmd : $!";
	return 0;
    }
    my @lines = <CMD>;
    close CMD;
    #
    # produce metrics for each matcher
    #
    for my $metric (@{$callbacks{$cmd}{blocks}}) {
	&apply_filter($metric, $interval, \@lines);
    }
    return 1;
}

sub apply_filter {
    my ($mc, $interval, $op) = @_;
    my ($match, $hostmatch, $valmatch, $units);
    $match = $mc->{match};
    if (exists($mc->{host})) {
	$hostmatch = $mc->{host};
    }
    if (exists($mc->{value})) {
	$valmatch = $mc->{value};
    } else {
	$valmatch = '$1';
    }
    $units = $mc->{units};
    foreach (@{$op}) {
	if (scalar(m/$match/)) {
	    my ($host,$value);
	    eval "\$value = $valmatch";
	    if ($@) {
		logit "err", "value match failed!\n";
		return 0;
	    }
	    if ($hostmatch) {
		eval "\$host  = $hostmatch";
		if ($@) {
		    logit "err", "value match failed!\n";
		    return 0;
		}
	    }
	    if ($units =~ m/^\$\d$/) {
		eval "\$units = $units";
		if ($@) {
		    logit "err", "units match failed!\n";
		    return 0;
		}
	    }
	    # now send data through gmetric
	    &announce_metric($mc->{name}, $value, $mc->{type},
			     $units, $interval, $host);
	}
    }
}

sub load_modules {
    my ($metrics) = @_;
    my ($modstring, %modules);
    # The order of loading modules matters, therefore we expect it
    # to be correct in the string. We pick the longest string...
    for my $metric (@{$metrics}) {
	if (exists $metric->{modules}) {
	    map { $modules{$_}=1; } split(" ",$metric->{modules});
	    if (length($metric->{modules}) > length($modstring)) {
		$modstring = $metric->{modules};
	    }
	}
    }
    if ($modstring) {
	# all this mess is done in order to get a sane ordering for module
	# loading even if the user made some mistakes in the config
	map { delete $modules{$_}; } split (" ", $modstring);
	$modstring .= " ".join(" ",keys %modules);
	map { delete $modules{$_}; } keys %modules;
	
	# which modules are loaded, actually?
	map { my ($m,$d) = split(" ",$_);
	      $modules{$m} = 1; } `cat /proc/modules`;
	# and now load them...
	my $loaded = 0;
	for my $m (split(" ",$modstring)) {
	    if (! exists $modules{$m}) {
		$loaded++;
		!system("/sbin/modprobe $m >/dev/null 2>&1") or do {
		    logit "err", "Failed to load module: $m: $!";
		}
	    }
	}
	# sleep 3 seconds, just in case the modules' init takes longer
	if ($loaded) {
	    sleep 3;
	}
    }
}

#
# spoofing of host IP is supported in post 3.0.3 ganglia.
#
sub announce_metric {
    my ($name, $value, $type, $units, $interval, $host) = @_;

    my ($cmd, $ip);

    $cmd = "$gmetric --name=\"$name\" --value=\"$value\""
	. " --type=\"$type\" --units=\"$units\" --tmax=$interval";

    $cmd = $cmd . " --mcast_channel=$gmond_channel" if $gmond_channel;
    $cmd = $cmd . " --mcast_port=$gmond_port" if $gmond_port;
    $cmd = $cmd . " --mcast_if=$gmond_if" if $gmond_if;

    if ($host) {
	my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
	if (!@addrs) {
	    logit "err", "Host not found: $host\n";
	    return 0;
	} else {
	    $ip = inet_ntoa($addrs[0]);
	    $cmd .= " --spoof $ip:$host";
	}
    }
    logit "info", "$cmd\n" if $debug;
    if (system($cmd)) {
	logit "err", "Command failed: $cmd\n";
    }
}

sub parse_cfg_dir {
    my ($dir) = @_;
    local *CFG;
    opendir CFG, "$dir" or die "Could not read directory $dir!";
    my @files = readdir(CFG);
    for my $file (sort @files) {
	chomp $file;
	logit "info", "parse_cfg_dir: file=$file\n" if ($verbose);
	next if ($file !~ /^[a-zA-Z0-9]/);
	my %c = &parse_cfg("$dir/$file");
	# merge with global configuration
	for my $k (keys %c) {
	    if ($k ne "default" && exists($cfg{$k})) {
		die "Duplicate metric definition detected: [$k] in $dir/$file";
	    }
	    if ($k eq "default" && exists($cfg{default})) {
		for my $sk (%{$c{default}}) {
		    $cfg{default}{$sk} = $c{default}{$sk};
		}
	    } else {
		$cfg{$k} = $c{$k};
	    }
	}
    }
    closedir CFG;
    logit "info", "parse_cfg_dir:\n".Dumper(%cfg) if ($debug);
}

sub parse_cfg {
    my ($cfgfile) = @_;
    my @keywords = qw( cmd
		       modules
		       interval
		       match
		       host
		       value
		       units
		       type
		       debug
		       );
    my $keymatch = join("|", @keywords);
    logit "info", "keymatch : $keymatch\n" if ($verbose);

    my %cfg;
    my $name = "default";
    if (!open(CFG, $cfgfile)) {
	logit 'err', "ERROR: Couldn't open file $cfgfile!\n";
	exit 1;
    }
    while (<CFG>) {
	chomp;
	next if (/^\s*\#/ or /^\s*$/);

	if (/\s*\[(\w+)\]/) {
	    $name=$1;
	    logit "info", "found metric definition block $name\n" if $verbose;
	    if (exists $cfg{$name}) {
		logit "err", "Duplicate metric definition: $name. Check the configuration file!\n";
		exit 1;
	    }
	    $cfg{$name}{name} = $name;
	} else {
	    m/^\s*([^=]+)\s*=\s*(.*)\s*$/;
	    my ($key,$value) = ($1, $2);
	    $key =~ s/\s//g;
	    $value =~ s/^\s*\"//;
	    $value =~ s/^\s*\'//;
	    $value =~ s/\"\s*$//;
	    $value =~ s/\'\s*$//;
	    logit "info", "key=$key, val=$value\n" if $verbose;
	    if ($key !~ m/^($keymatch)$/) {
		logit "err", "invalid keyword: $key. Ignoring.\n";
	    } else {
		$cfg{$name}{$key} = $value;
	    }
	}
    }
    close(CFG);
    return %cfg;
}

sub validate_cfg {
    my (%c) = @_;
    my $err = 0;
    my @block_keys = qw( cmd match );
    my @global_keys = qw( interval units type );
    for my $m (keys(%c)) {
	next if ($m eq "default");

	for my $k (@block_keys) {
	    if (!exists($c{$m}{$k})) {
		logit "err", "Keyword \"$k\" not found for block $m!\n";
		$err++;
	    }
	}
	for my $k (@global_keys) {
	    if (!exists($c{$m}{$k}) && !exists($c{default}{$k})) {
		logit "err", "Keyword \"$k\" not found for block $m and no global $k defined!\n";
		$err++;
	    }
	}
    }
    return $err;
}

sub min {
    my ($a, $b) = @_;
    return $a if ($a <= $b);
    return $b;
}

sub callbacks_cfg {
    my (%cfg) = @_;
    my %cb;
    my $interval;
    if (exists($cfg{default}{interval})) {
	$interval = $cfg{default}{interval};
    }
    for my $metric (keys(%cfg)) {
	next if ($metric eq "default");
	my $cmd = $cfg{$metric}{cmd};
	if (exists($cb{$cmd}{interval})) {
	    if (exists($cfg{$metric}{interval})) {
		$cb{$cmd}{interval} = &min($cb{$cmd}{interval},
					   $cfg{$metric}{interval});
	    }
	} else {
	    if (exists($cfg{$metric}{interval})) {
		$cb{$cmd}{interval} = $cfg{$metric}{interval};
	    } else {
		$cb{$cmd}{interval} = $interval;
	    }
	}
	push @{$cb{$cmd}{blocks}}, $cfg{$metric};
    }
    return %cb;
}


sub parse_gmond_conf {
    my $name;

    if (!open(CFG, $gmond_conf)) {
	logit('err', "ERROR: Couldn't open file $gmond_conf!");
	exit 1;
    }
    while (<CFG>) {
	chomp;
	next if (/^\s*\#/);

	s/^\s//;
	my @line = split /\s+/;
	my $value = $line[1];
	for ($line[0]) {
	    /^mcast_channel$/ && do {
		$gmond_channel = $value;
		last;
	    };
	    /^mcast_if$/ && do {
		$gmond_if = $value;
		last;
	    };
	    /^mcast_port$/ && do {
		$gmond_port = $value;
		last;
	    };
	}
    }
    close(CFG);
}
